home *** CD-ROM | disk | FTP | other *** search
VERSION 4.00 Begin VB.Form MainForm Caption = "Test PANEL for Testing aiNet Functions" ClientHeight = 7068 ClientLeft = 924 ClientTop = 3372 ClientWidth = 8160 Height = 7452 Icon = "Panel.frx":0000 Left = 876 LinkTopic = "Form1" ScaleHeight = 7068 ScaleWidth = 8160 Top = 3036 Width = 8256 Begin VB.CommandButton InfoBtn BackColor = &H000000FF& Caption = "Info" Height = 372 Left = 6840 TabIndex = 13 Top = 2040 Width = 1092 End Begin VB.CommandButton SaveBtn Caption = "Save Model" Height = 372 Left = 5520 TabIndex = 12 Top = 1560 Width = 1212 End Begin VB.CommandButton GenerateBtn Caption = "Generate MV" Height = 372 Left = 5520 TabIndex = 11 Top = 2040 Width = 1212 End Begin VB.CommandButton SettingsBtn Caption = "Settings" Height = 372 Left = 4200 TabIndex = 10 Top = 2040 Width = 1212 End Begin VB.CommandButton ExcludeBtn Caption = "Exclude MV" Height = 372 Left = 2880 TabIndex = 9 Top = 2040 Width = 1212 End Begin VB.CommandButton NewMVBtn Caption = "New MV" Height = 372 Left = 1560 TabIndex = 8 Top = 2040 Width = 1212 End Begin VB.CommandButton ShowModelBtn Caption = "Show Model" Height = 372 Left = 240 TabIndex = 7 Top = 2040 Width = 1212 End Begin VB.CommandButton ExitBtn BackColor = &H00C0C0C0& Caption = "Exit" Height = 372 Left = 6840 TabIndex = 6 Top = 1560 Width = 1092 End Begin VB.CommandButton NewCapacityBtn Caption = "New Capacity" Height = 372 Left = 4200 TabIndex = 5 Top = 1560 Width = 1212 End Begin VB.CommandButton PredictBtn Caption = "Prediction" Height = 372 Left = 2880 TabIndex = 4 Top = 1560 Width = 1212 End Begin VB.CommandButton PredictionBtn Caption = "Load Sample" Height = 372 Left = 1560 TabIndex = 3 Top = 1560 Width = 1212 End Begin VB.CommandButton StatusBtn Caption = "Status Report" Height = 372 Left = 240 TabIndex = 2 Top = 1560 Width = 1212 End Begin VB.TextBox tOut BeginProperty Font name = "Courier New" charset = 1 weight = 400 size = 10.2 underline = 0 'False italic = 0 'False strikethrough = 0 'False EndProperty Height = 4332 Left = 240 MultiLine = -1 'True ScrollBars = 2 'Vertical TabIndex = 1 Top = 2520 Width = 7692 End Begin VB.PictureBox Picture1 BorderStyle = 0 'None Height = 1452 Left = 240 Picture = "Panel.frx":0442 ScaleHeight = 1452 ScaleWidth = 7692 TabIndex = 0 Top = 120 Width = 7692 End Attribute VB_Name = "MainForm" Attribute VB_Creatable = False Attribute VB_Exposed = False ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Support for text output Public NL As String ' Carriage return + newline Public T As String ' tab ' Various global variables Public Ret As Long ' Used as return value for aiXX function calls. Public X As Single ' Temporary vector Public Y As Single Public Par1 As Long ' Transfer variables Public Par2 As Long Public PenaltyCoeff As Double ' Penalty coefficient value Public NormType As Long ' Type of normalization Public PenaltyType As Long ' Type of penalty function Public InfListSize As Long ' Size of the influence list Public InfListType As Long ' Type of the influence list Public FileName As String ' The model! Public Model As Long Sub ReportError(ByVal err As Long) If err <> AIERR_NO_ERROR Then tOut = tOut + NL + "Error[" + CStr(err) + "]: " If err = AIERR_PENALTY_ZERO Then tOut = tOut + "Penalty parameter was set to ZERO!" If err = AIERR_NO_IO_VARIABLES Then tOut = tOut + "Input or Output variables are not properly defined! There must be at least one input and one ouput variable." If err = AIERR_PENALTY_TOO_SMALL Then tOut = tOut + "The penalty parameter value is too small!" If err = AIERR_EMPTY_ROW Then tOut = tOut + "An empty row was found in the model. There must be no empty rows in the model!" If err = AIERR_EMPTY_COLUMN Then tOut = tOut + "An empty column was found in the model. There must be no empty rows in the model!" If err = AIERR_EQUAL_COLUMN Then tOut = tOut + "All values in one columns are the same. The normalization is not possible!" If err = AIERR_CSV_OPEN Then tOut = tOut + "Unable to open a CSV file!" If err = AIERR_CSV_READ Then tOut = tOut + "Unable to read from CSV file. Wrong format!" If err = AIERR_MEMORY_ALLOCATION Then tOut = tOut + "Unable to allocate new memory!" If err = AIERR_INVALID_POINTER Then tOut = tOut + "Specified poitner (model) is invalid!" If err = AIERR_INVALID_INDEX Then tOut = tOut + "Specified index is invalid - out of range!" If err = AIERR_NO_FREE_ENTRY Then tOut = tOut + "There are no free entries in the model!" End If End Sub Sub SetupStrings() NL = Chr(13) + Chr(10) T = Chr(9) End Sub Private Function IsHole(ByVal X As Single, ByVal Y As Single) As Boolean r = Sqr(X * X + Y * Y) If r > 0.7 Then IsHole = False Else IsHole = True End If End Function Private Sub ExcludeBtn_Click() If Model = 0 Then tOut = NL + "Load the model first!" Else Ret = 0 ExcludeMV.Show 1 If Ret <> 0 Then tOut = NL + "Exclude Model Vectors:" + NL Dim exclude As Long If Ret = 1 Or Ret = 2 Then exclude = 0 ' Ret = 2 ... include If Ret = 1 Then exclude = 1 If ExcludeMV.Range = True Then Dim first As Long Dim last As Long first = CStr(ExcludeMV.first) last = CStr(ExcludeMV.last) Par1 = aiExcludeModelVectorRange(Model, first, last, exclude) Else Dim index As Long index = CStr(ExcludeMV.index) Par1 = aiExcludeModelVector(Model, index, exclude) End If If Par1 = AIERR_NO_ERROR Then If ExcludeMV.Range = True Then tOut = tOut + "Model Vectors int the range [" + ExcludeMV.first + "," + ExcludeMV.last + "] were " Else tOut = tOut + "Model Vector at index [" + ExcludeMV.index + "] was " End If If exclude = 1 Then tOut = tOut + "excluded!" Else tOut = tOut + "included!" End If tOut = tOut + NL + NL + "Select 'Status Report' or 'Show Model' button!" Else ReportError (Par1) End If Else ' Ret = 3 - Delete index = CStr(ExcludeMV.index) Par1 = aiDeleteModelVector(Model, index) If Par1 < 0 Then ReportError (Par1) Else tOut = tOut + "Model Vector at index [" + ExcludeMV.index + "] was deleted!" End If End If End If End If End Sub Private Sub ExitBtn_Click() End End Sub Private Sub Form_Load() X = 0 Y = 0 SetupStrings Model = 0 'It is very impotant to make clear that model is not set yet! Settings.Regular = True NormType = NORMALIZE_REGULAR Settings.Static = True PenaltyType = PENALTY_STATIC PenaltyCoeff = 0.2 Settings.Coefficient = CStr(PenaltyCoeff) InfListSize = 0 Settings.listSize = "0" InfListType = MOST_INFLUENT Settings.ShowMost = True 'You can put the registration code here' 'Ret = aiRegistration("Your Name", "Your Code") ShowInfo End Sub Private Sub DisplayStatus() Dim nMV As Long Dim nVar As Long Dim Version As Long Version = aiGetVersion() major = Int(Version / 100) minor = Version Mod 100 tOut = "aiNetDLL version " + CStr(major) + "." + CStr(minor) tOut = tOut + " (C) Copyright by aiNet, 1997" + NL + NL If Model = 0 Then tOut = tOut + "Model is not initialized yet!" + NL + "There is nothing to report." Else tOut = tOut + "Model Data Structure" + NL nVar = aiGetNumberOfVariables(Model) tOut = tOut + T + "Number of variables: " + CStr(nVar) + NL Ret = aiGetNumberOfInputVariables(Model) tOut = tOut + T + "Number of input variables: " + CStr(Ret) + NL nMV = aiGetNumberOfModelVectors(Model) tOut = tOut + T + "Number of model vectors: " + CStr(nMV) + NL Ret = aiGetCapacity(Model) tOut = tOut + T + "Model capacity: " + CStr(Ret) + NL Ret = aiGetFreeEntries(Model) tOut = tOut + T + "Model free entries: " + CStr(Ret) + NL i = nVar tOut = tOut + T + "Discrete flags for variables: " While i > 0 tOut = tOut + CStr(aiGetDiscreteFlag(Model, i)) If i <> 1 Then tOut = tOut + ", " i = i - 1 Wend tOut = tOut + NL tOut = tOut + T + "Number of excluded model vectors: " i = 1 counter = 0 While i <= nMV If aiIsModelVectorExcluded(Model, i) = 1 Then counter = counter + 1 i = i + 1 Wend tOut = tOut + CStr(counter) + NL tOut = tOut + "End of Model Data Structure." End If End Sub Private Sub ShowModel() Dim nMV As Long Dim nVar As Long Dim nInp As Long Dim Cap As Long If Model = 0 Then tOut = "Model is not initialized yet!" + NL + "There is nothing to show!" + NL + NL + "Load the model first!" Else tOut = "Model Data:" + NL nVar = aiGetNumberOfVariables(Model) nInp = aiGetNumberOfInputVariables(Model) nMV = aiGetNumberOfModelVectors(Model) Cap = aiGetCapacity(Model) If Cap > 100 Then tOut = tOut + "Warning: Only first 100 entries will be shown on screen!" + NL Cap = 100 End If For r = 1 To Cap tOut = tOut + CStr(r) + ": " If r <= nMV Then For c = 1 To nVar tOut = tOut + CStr(aiGetVariable(Model, r, c)) 'Here is an alternative to the statement above. 'Dim x As Single 'Ret = aiGetVariableVB(Model, r, c, x) 'tOut = tOut + CStr(x) If c <> nVar Then tOut = tOut + ", " Next If aiIsModelVectorExcluded(Model, r) = 1 Then tOut = tOut + ", Excluded" End If Else tOut = tOut + "Free entry" End If tOut = tOut + NL Next End If End Sub Private Sub Form_Terminate() If Model <> 0 Then aiDeleteModel (Model) End If End Sub Private Sub GenerateBtn_Click() If Model = 0 Then tOut = NL + "Load the model first!" Else Generate.Show 1 tOut = "The Generate Command:" + NL + NL If Ret > 0 Then Dim free As Long free = aiGetFreeEntries(Model) If free > 0 Then ReDim vec(1 To 3) As Single For i = 1 To free vec(1) = Rnd * 2 - 1 vec(2) = Rnd * 2 - 1 vec(3) = 0# If IsHole(vec(1), vec(2)) Then vec(3) = 1# Ret = aiAppendModelVector(Model, vec(1)) If Ret < 0 Then ReportError (Ret) Next tOut = tOut + NL + CStr(free) + " randomly generated model vectors were appended to the model." Else tOut = tOut + "There are no free entries in the model!" + NL tOut = tOut + "Make some free entries first. Use the 'New Capacity' command!" + NL End If Else tOut = tOut + "The command was canceled!" End If End If End Sub Private Sub InfoBtn_Click() ShowInfo End Sub Private Sub NewCapacityBtn_Click() If Model <> 0 Then Dim nMV As Long nMV = aiGetNumberOfModelVectors(Model) Capacity.Capacity = CStr(aiGetCapacity(Model)) Capacity.ModelVectors = CStr(nMV) Capacity.FreeEntries = CStr(aiGetFreeEntries(Model)) Ret = 0 Capacity.Show 1 If Ret <> 0 Then tOut = "You set the new model capacity to " + CStr(Ret) + "entries." + NL If Ret < nMV Then tOut = tOut + CStr(nMV - Ret) + " model vectors in the range [" + CStr(Ret) + " - " + CStr(nMV) + "]were be deleted." Else tOut = tOut + "There is exactly " + CStr(Ret - nMV) + " free entries in the model." End If tOut = tOut + NL + NL + "Select 'Status Report' button to see the new model status." Ret = aiSetCapacity(Model, Ret) End If Else tOut = NL + "Load the model first!" End If End Sub Private Sub NewMVBtn_Click() ReDim Vector(1 To 3) As Single If Model = 0 Then tOut = NL + "Load the model first!" Else tOut = "New model vector command!" + NL + NL Ret = 0 ' Ok/Cancel NewMV.XC = CStr(X) NewMV.YC = CStr(Y) If NewMV.index = "" Then NewMV.index = "0" NewMV.Show 1 If Ret <> 0 Then Dim index As Long index = CLng(NewMV.index) Vector(1) = X Vector(2) = Y If Sqr(X * X + Y * Y) > 0.7 Then Vector(3) = 0 Else Vector(3) = 1 End If If NewMV.Insert = True Then tOut = tOut + "Insert mode" + NL Ret = aiInsertModelVector(Model, index, Vector(1)) Else If NewMV.Overwrite = True Then tOut = tOut + "Overwrite mode" + NL Ret = aiOverwriteModelVector(Model, index, Vector(1)) Else tOut = tOut + "Append mode" + NL Ret = aiAppendModelVector(Model, Vector(1)) End If End If If Ret < 0 Then ReportError (Ret) Else If NewMV.Append = False Then tOut = tOut + "Successfully processed at index " + CStr(Ret) Else tOut = tOut + "Successfully appended." End If End If End If ' Ret <>0 End If ' Model <> 0 End Sub Private Sub PredictBtn_Click() If Model = 0 Then tOut = "You must load the model first!" + NL + NL + "Select the 'Load Sample' button!" Else tOut = "Results of prediction:" + NL tOut = tOut + "Normalization: " If NormType = NORMALIZATION_REGULAR Then tOut = tOut + "Regular" + NL Else tOut = tOut + "Statistical" + NL End If tOut = tOut + "Penalty Type: " If PenaltyType = PENALTY_STATIC Then tOut = tOut + "Static" + NL Else If PenaltyType = PENALTY_DYNAMIC Then tOut = tOut + "Dyamic" + NL Else tOut = tOut + "Nearest" + NL End If End If tOut = tOut + "Penalty Coefficient: " + CStr(PenaltyCoeff) + NL tOut = tOut + "Size of the Influence List: " + CStr(InfListSize) + NL tOut = tOut + "Type of the Influence List: " If InfListType = MOST_INFLUENT Then tOut = tOut + "Show Most Influent MVs" Else tOut = tOut + "Show Least Influent MVs" End If tOut = tOut + NL + NL ' Prediction tOut = tOut + "Prediction ..." + NL tOut = tOut + "X, Y -> pred IN/OUT, Correct/Incorrect, Influence list" + NL ReDim predict(0 To 17) As Single predict(0) = 0.75: predict(1) = 0#: predict(2) = 0 'First prediction vector predict(3) = 0.325: predict(4) = 0.563: predict(5) = 1 '2nd prediction vector predict(6) = -0.375: predict(7) = 0.65: predict(8) = 0 '... predict(9) = -0.65: predict(10) = 0#: predict(11) = 1 predict(12) = -0.375: predict(13) = -0.65: predict(14) = 0 predict(15) = 0.325: predict(16) = -0.563: predict(17) = 1 '6th prediction vector ReDim list(1 To 2) As Long If InfListSize > 0 Then ReDim list(1 To InfListSize) As Long End If Ret = aiNormalize(Model, NormType) ReportError (Ret) 'Just in case For i = 0 To 5 Ret = aiPredictionEx(Model, predict(i * 3), PenaltyCoeff, PenaltyType, list(1), InfListSize, InfListType) ReportError (Ret) 'Just in case tOut = tOut + CStr(predict(i * 3)) + ", " + CStr(predict(i * 3 + 1)) + " -> " + CStr(predict(3 * i + 2)) + ": " Dim in1 As Boolean ' correct answer in1 = IsHole(predict(i * 3), predict(i * 3 + 1)) Dim in2 As Boolean ' predicted answer in2 = predict(i * 3 + 2) >= 0.5 If in1 = in2 Then ' Are both answers the same ? tOut = tOut + "Correct : " Else tOut = tOut + "Incorrect : " End If If InfListSize > 0 Then For j = 1 To InfListSize tOut = tOut + CStr(list(j)) If j <> InfListSize Then tOut = tOut + ", " Next End If tOut = tOut + NL Next Ret = aiDenormalize(Model) ReportError (Ret) 'Just in case End If End Sub Private Sub PredictionBtn_Click() If Model <> 0 Then aiDeleteModel (Model) Model = 0 End If ' If the model does not load in your computer, then enter full path to ' the hole.csv file below!!! FileName = "c:\cpp\ainet\dll\vb4\32bit\hole.csv" Model = aiCreateModelFromCSVFile(FileName) If Model = 0 Then tOut = "Model creation failed!" + NL + NL tOut = tOut + "There can be three reasons for such behaviour:" + NL tOut = tOut + "1. There is not enough system memory to create the model (very unlikely)" + NL tOut = tOut + "2. The CSV file can not be found. Check the file path in the source code!" + NL tOut = tOut + "3. The CSV file is corrupt. Check the file contents!" Else tOut = "File [" + FileName + "] was read" + NL tOut = tOut + "and model was created successfully!" + NL + NL tOut = tOut + "Select 'Status Report' button to see the model status." End If End Sub Private Sub SaveBtn_Click() tOut = "The 'Save Model' command." + NL If Model = 0 Then tOut = NL + "There is nothing to save!" + NL tOut = tOut + "Load the model first!" Else Ret = aiSaveCSVFile(Model, FileName) If Ret < 0 Then ReportError (Ret) tOut = tOut + "The model was saved in CSV format on file [" + FileName + "]." + NL End If End Sub Private Sub SettingsBtn_Click() Settings.Show 1 If Ret = 1 Then NormType = NORMALIZE_STATISTICAL If Settings.Regular = True Then NormType = NORMALIZE_REGULAR PenaltyType = PENALTY_STATIC If Settings.Dynamic = True Then PenaltyType = PENALTY_DYNAMIC If Settings.NN = True Then PenaltyType = PENALTY_NEAREST PenaltyCoeff = CDbl(Settings.Coefficient) InfListSize = CLng(Settings.listSize) InfListType = LEAST_INFLUENT If Settings.ShowMost = True Then InfListType = MOST_INFLUENT tOut = NL + "New Settings were set." tOut = tOut + NL + "Click 'Settings' button again to see the new settings!" Else tOut = "" End If End Sub Private Sub ShowModelBtn_Click() ShowModel End Sub Private Sub StatusBtn_Click() DisplayStatus End Sub Private Sub ShowInfo() tOut = "About this sample program" + NL tOut = tOut + "=========================" + NL + NL tOut = tOut + "This program is intended to serve as a test panel for aiNet.DLL " tOut = tOut + "library functions. Almost all functions that can be found " tOut = tOut + "in aiNet.DLL are used in this application. The functions " tOut = tOut + "are used in a direct way, usually without parameter " tOut = tOut + "validation. We suggest you to study the source code. " tOut = tOut + "You may modify the source code as mush as you want. " tOut = tOut + "Actually, you will have to modify at least the path " tOut = tOut + "to the 'HOLE.CSV' file to bring this program to life." tOut = tOut + NL + NL + "Enjoy!" + NL + NL + NL + "A.K. aiNet, 1997" End Sub 
(.txt)